home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / ptoolwi4.arc / PTOOLWI4.INC
Text File  |  1985-09-12  |  13KB  |  323 lines
  1.  { PTOOLWI4.INC   Copyright 1984  R D Ostrander                   Version 4.0
  2.                                  Ostrander Data Services              of
  3.                                  5437 Honey Manor Dr              PTOOLWIN.INC
  4.                                  Indianapolis  IN  46241
  5.  
  6.  These Turbo Pascal procedures are text window manipulation tools used to ease
  7.  the manipulation of Windows in an IBM PC environment. They are used to open
  8.  and close windows while saving the data covered by the window. Borders around
  9.  windows are also supported.
  10.  
  11.  This program has been placed in the Public Domain by the author and copies
  12.  may be freely made for non-commercial, demonstration, or evaluation purposes.
  13.  Use of these subroutines in a program for sale or for commercial purposes in
  14.  a place of business requires a $20 fee be paid to the author at the address
  15.  above.  Personal non-commercial users may also elect to pay the $20 fee to
  16.  encourage further development of this and similar programs. With payment you
  17.  will be able to receive update notices, diskettes and printed documentation
  18.  of this and other PTOOLs from Ostrander Data Services.
  19.  
  20.  PTOOL, and PTOOLxxx are Copyright Trademarks of Ostrander Data Services
  21.  
  22.  Turbo Pascal is a Copyright of Borland International Inc.
  23.  
  24.  Version 2.0 adds support for stack operations for holding screen image data.
  25.  
  26.  Version 3.0 automatically determines whether to use C/G or Monochrome
  27.  monitor card if the PTOOLWIN_Screen_Type variable is left as an 'X'.
  28.  This was written by Lew Paper using routines developed by Bela Lubkin.
  29.  
  30.  Version 4.0 replaces original DetermineDisplay procedure with simpler one;
  31.  replaces 'write' calls with new procedure 'putchr' for drawing of box;
  32.  
  33.                                                          - DJ Pajerek 9/85
  34.  
  35. Procedures and Functions available in PTOOLWI2.INC are:
  36.  
  37.  PTWSet  (Screen#, X1, Y1, X2, Y2,  - Sets up window coordinates so that later
  38.          BorderSwitch,                references can be made by Mnemonic only.
  39.          BackgroundColor,             PTWSet must be done once for each window
  40.          ForegroundColor)             before it is Opened.
  41.                                       The Screen# is a number between 1 and
  42.                                       the maximum number of windows allowable
  43.                                       set in the Constants Block below.
  44.                                       The X and Y Coordinates are the same as
  45.                                       for the Turbo Pascal Window procedure.
  46.                                       A border may be placed around the window
  47.                                       and the size of the window will be
  48.                                       decreased to fit inside the border. The
  49.                                       BorderSwitch functions are:
  50.                                          0 - No border
  51.                                          1 - Single line block graphics border
  52.                                          2 - Double line block graphics border
  53.                                         -1 - Single line Reversed color border
  54.                                         -2 - Double line Reversed color border
  55.                                       The BackgroundColor and ForegroundColor
  56.                                       parameters are the same as for the Turbo
  57.                                       Pascal TextColor and TextBackground
  58.                                       procedures.
  59.  
  60.  PTWOpen (Screen#)                  - Activates a window (previously set by
  61.                                       PTWSet) and saves the screen covered by
  62.                                       the window.
  63.                                       In the Constants Block following, there
  64.                                       is a parameter that sets the maximum
  65.                                       number of windows that may be open at
  66.                                       any one time.
  67.  
  68.  PTWClose                           - De-activates the open window, activates
  69.                                       the previous window and restores the
  70.                                       screen covered by the closed window.
  71.                                       Note that the PTWOpen & PTWClose have a
  72.                                       "Push/Pop" type of action.
  73.                                                                             }
  74.  
  75.  
  76. { Constant Values (Parameters) That must be included in your source program }
  77.  
  78. (*
  79. CONST
  80.  
  81.    PTOOLWIN_Number_of_Windows = nn;    { This determines the number of      }
  82.                                        { windows that may be set with the   }
  83.                                        { PTWSet procedure.                  }
  84.                                        { This also determines the maximum   }
  85.                                        { number of windows that may be open }
  86.                                        { at any one time.                   }
  87.                                        { Use the greater of the two.        }
  88.  
  89.                                                                            *)
  90.  
  91. { Areas for internal use Begin Here **************************************** }
  92.  
  93. TYPE
  94.  
  95.      PTOOLWIN_Set_Info  = Record
  96.                             PTOOLWIN_X1       : Integer;
  97.                             PTOOLWIN_Y1       : Integer;
  98.                             PTOOLWIN_X2       : Integer;
  99.                             PTOOLWIN_Y2       : Integer;
  100.                             PTOOLWIN_Border   : Integer;
  101.                             PTOOLWIN_Back     : Integer;
  102.                             PTOOLWIN_Fore     : Integer;
  103.                           End;
  104.  
  105.      PTOOLWIN_Stacks    = Array [1..25] of String [160];
  106.  
  107.  
  108. CONST
  109.      PTOOLWIN_Screen_Type : Char = 'X'; {Initial value neither 'M' or 'C', LP}
  110.  
  111.  
  112. VAR
  113.  
  114.      PTOOLWIN_C_Screen   : Char absolute $B800:$0000;
  115.      PTOOLWIN_M_Screen   : Char absolute $B000:$0000;
  116.  
  117.      PTOOLWIN_Set        : Array [1..PTOOLWIN_Number_of_Windows]
  118.                                   of PTOOLWIN_Set_Info;
  119.  
  120.      PTOOLWIN_Stack_Num  : Array [1..PTOOLWIN_Number_of_Windows] of Integer;
  121.      PTOOLWIN_Stack_X    : Array [1..PTOOLWIN_Number_of_Windows] of Integer;
  122.      PTOOLWIN_Stack_Y    : Array [1..PTOOLWIN_Number_of_Windows] of Integer;
  123.      PTOOLWIN_Stack      : Array [1..PTOOLWIN_Number_of_Windows]
  124.                                   of ^PTOOLWIN_Stacks;
  125.  
  126.      PTOOLWIN_Curr       : PTOOLWIN_Set_Info;
  127.  
  128.  
  129. CONST
  130.  
  131.      PTOOLWIN_Stack_Size : Byte = 0;
  132.  
  133.      PTOOLWIN_Full_Screen : PTOOLWIN_Set_Info = (PTOOLWIN_X1     : 1;
  134.                                                  PTOOLWIN_Y1     : 1;
  135.                                                  PTOOLWIN_X2     : 80;
  136.                                                  PTOOLWIN_Y2     : 25;
  137.                                                  PTOOLWIN_Border : 0;
  138.                                                  PTOOLWIN_Back   : 0;
  139.                                                  PTOOLWIN_Fore   : 15);
  140.  
  141. { Internal Procedures Begin Here ****************************************** }
  142.  
  143.  
  144. { * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  145.  
  146.  Adapted from WINDOW.PAS
  147.               by Bela Lubkin
  148.               Borland International Technical Support
  149.  
  150.  Lew Paper, 5/12/85                                                        }
  151.  
  152. { djp Modification 9/85 }
  153.  
  154. Procedure DetermineDisplay;
  155.  
  156. { Set ScreenBase to $B000 or $B800, depending on which display is in use.
  157.   A side effect is that the cursor is left at (1,1) on the screen. }
  158.  
  159.   Var
  160.      Video_Mode:  byte absolute $0000:$0449;
  161.  
  162.   Begin
  163.      If Video_Mode = 7 then PTOOLWIN_Screen_Type := 'M'
  164.      Else PTOOLWIN_Screen_Type := 'C'
  165.   End;
  166.  
  167. Procedure PutChr(outchr: char);
  168.  
  169. {Output A Single Character Using ROM BIOS Call - djp}
  170.  
  171. type
  172.   regpack = record
  173.               ax,bx,cx,dx,bp,di,si,ds,es,flags: integer;
  174.             end;
  175.  
  176. var
  177.   recpack:          regpack;
  178.   attr:             byte;
  179.  
  180. begin
  181.   with recpack do
  182.   begin
  183.     ax := $0E00 + ord(outchr);
  184.     bx := $0000;
  185.   end;
  186.   intr($10,recpack)
  187. end;
  188.  
  189. { * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  190.  
  191. Procedure PTOOLWIN_Open_Window (Screen : Integer; OpenType : Char);
  192.  
  193. {All 'Write' Procedure Calls Replaced by 'PutChr' - djp}
  194.  
  195. Var
  196.    I  : Byte;
  197.  
  198. Begin
  199.      If (Screen = 0) or
  200.         (PTOOLWIN_Stack_Size = 0) then PTOOLWIN_Curr := PTOOLWIN_Full_Screen
  201.                                   else PTOOLWIN_Curr := PTOOLWIN_Set [Screen];
  202.      With PTOOLWIN_Curr do
  203.      Begin
  204.           Window (PTOOLWIN_X1, PTOOLWIN_Y1,
  205.                   PTOOLWIN_X2, PTOOLWIN_Y2);
  206.           If PTOOLWIN_Border >= 0 then
  207.             Begin
  208.                   TextBackground (PTOOLWIN_Back);
  209.                   TextColor      (PTOOLWIN_Fore);
  210.             End
  211.           else
  212.             Begin
  213.                  TextBackground (PTOOLWIN_Fore);
  214.                  TextColor      (PTOOLWIN_Back);
  215.             End;
  216.          If OpenType = 'N' then ClrScr;                 {djp Modification}
  217.          If (Abs (PTOOLWIN_Border) = 1) and
  218.             (OpenType = 'N') then
  219.             Begin
  220.                  Gotoxy (1,1); PutChr ('┌');
  221.                  For I := 2 to PTOOLWIN_X2 - PTOOLWIN_X1 do
  222.                      PutChr ('─');
  223.                  PutChr ('┐');
  224.                  For I := 2 to PTOOLWIN_Y2 - PTOOLWIN_Y1 do
  225.                      Begin
  226.                           Gotoxy (1, I);
  227.                           PutChr ('│');
  228.                           Gotoxy (PTOOLWIN_X2 - PTOOLWIN_X1 + 1, I);
  229.                           PutChr ('│');
  230.                      End;
  231.                  Gotoxy (1, PTOOLWIN_Y2 - PTOOLWIN_Y1 + 1); PutChr ('└');
  232.                  For I := 2 to PTOOLWIN_X2 - PTOOLWIN_X1 do
  233.                      PutChr ('─');
  234.             End;
  235.          If (Abs (PTOOLWIN_Border) = 2) and
  236.             (OpenType = 'N') then
  237.             Begin
  238.                  Gotoxy (1,1); PutChr ('╔');
  239.                  For I := 2 to PTOOLWIN_X2 - PTOOLWIN_X1 do
  240.                      PutChr ('═');
  241.                  PutChr ('╗');
  242.                  For I := 2 to PTOOLWIN_Y2 - PTOOLWIN_Y1 do
  243.                      Begin
  244.                           Gotoxy (1, I);
  245.                           PutChr ('║');
  246.                           Gotoxy (PTOOLWIN_X2 - PTOOLWIN_X1 + 1, I);
  247.                           PutChr ('║');
  248.                      End;
  249.                  Gotoxy (1, PTOOLWIN_Y2 - PTOOLWIN_Y1 + 1); PutChr ('╚');
  250.                  For I := 2 to PTOOLWIN_X2 - PTOOLWIN_X1 do
  251.                      PutChr ('═');
  252.             End;
  253.          If PTOOLWIN_Border <> 0 then
  254.             Begin
  255.                  Window (PTOOLWIN_X1 + 1, PTOOLWIN_Y1 + 1,
  256.                          PTOOLWIN_X2 - 1, PTOOLWIN_Y2 - 1);
  257.                  If OpenType = 'N' then
  258.                     If Abs (PTOOLWIN_Border) = 1 then PutChr ('┘')
  259.                                                  else PutChr ('╝');
  260.             End;
  261.          TextBackground (PTOOLWIN_Back);
  262.          TextColor      (PTOOLWIN_Fore);
  263.      End;
  264. End;
  265.  
  266.  
  267. { Called Procedures Begin Here ******************************************** }
  268.  
  269.  
  270. PROCEDURE PTWSet (Window, X1, Y1, X2, Y2, Border, Back, Fore  : Integer);
  271.  
  272. BEGIN
  273.  
  274.      IF PTOOLWIN_Screen_Type = 'X' THEN DetermineDisplay; {LP modification}
  275.  
  276.      With PTOOLWIN_Curr do
  277.      Begin
  278.           PTOOLWIN_X1     := X1;
  279.           PTOOLWIN_Y1     := Y1;
  280.           PTOOLWIN_X2     := X2;
  281.           PTOOLWIN_Y2     := Y2;
  282.           PTOOLWIN_Border := Border;
  283.           PTOOLWIN_Back   := Back;
  284.           PTOOLWIN_Fore   := Fore;
  285.      End;
  286.      PTOOLWIN_Set [Window] := PTOOLWIN_Curr;
  287.  
  288. END;
  289.  
  290.  
  291. PROCEDURE PTWOpen (Screen : Integer);
  292.  
  293. BEGIN
  294.  
  295.      PTOOLWIN_Stack_Size := PTOOLWIN_Stack_Size + 1;
  296.      PTOOLWIN_Stack_Num [PTOOLWIN_Stack_Size] := Screen;
  297.      PTOOLWIN_Stack_X   [PTOOLWIN_Stack_Size] := WhereX;
  298.      PTOOLWIN_Stack_Y   [PTOOLWIN_Stack_Size] := WhereY;
  299.      New (PTOOLWIN_Stack [PTOOLWIN_Stack_Size]);
  300.      If PTOOLWIN_Screen_Type = 'C' then
  301.         Move (PTOOLWIN_C_Screen, PTOOLWIN_Stack [PTOOLWIN_Stack_Size]^, 4000)
  302.      else
  303.         Move (PTOOLWIN_M_Screen, PTOOLWIN_Stack [PTOOLWIN_Stack_Size]^, 4000);
  304.      PTOOLWIN_Open_Window (Screen, 'N');
  305.  
  306. END;
  307.  
  308.  
  309. PROCEDURE PTWClose;
  310.  
  311. BEGIN
  312.      If PTOOLWIN_Screen_Type = 'C' then
  313.         Move (PTOOLWIN_Stack [PTOOLWIN_Stack_Size]^, PTOOLWIN_C_Screen, 4000)
  314.      else
  315.         Move (PTOOLWIN_Stack [PTOOLWIN_Stack_Size]^, PTOOLWIN_M_Screen, 4000);
  316.      Dispose (PTOOLWIN_Stack [PTOOLWIN_Stack_Size]);
  317.      PTOOLWIN_Stack_Size := PTOOLWIN_Stack_Size - 1;
  318.      PTOOLWIN_Open_Window (PTOOLWIN_Stack_Num [PTOOLWIN_Stack_Size], 'R');
  319.      Gotoxy (PTOOLWIN_Stack_X [PTOOLWIN_Stack_Size + 1],
  320.              PTOOLWIN_Stack_Y [PTOOLWIN_Stack_Size + 1]);
  321.  
  322. END;                                                                                                                  
  323.